home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
4cmp22s.zip
/
DOSGOALT.4TH
< prev
next >
Wrap
Text File
|
1994-10-30
|
5KB
|
148 lines
\ COPYRIGHT 1994 BY THOMAS ALMY. ALL RIGHTS RESERVED
\ Permission is granted to registered users of ForthCMP to
\ sell or distrubute computer programs incorporating the compiled
\ contents of this file.
\ MS is a trademark of Microsoft Corporation.
\ This file is for standard MS-DOS operation, with or without a
\ separate stack segment.
\ This is a modified DOSGO which incorporates the exception wordset
\ and has handlers built in for divide by zero, control-C, and control-BREAK
\ traps. It serves as an example of how the startup file can be modified
\ for specific applications, but you might want to replace the existing DOSGO
\ with this one if you want the exception handling.
\ Note that the program must be exited via BYE (or bye) or via normal return
\ from MAIN (don't use the return 0 trick!), or you can exit via ABORT
\ (assuming you don't catch ABORT's THROW).
10
DECIMAL \ Values used by THROW
-1 CONSTANT Abort
-28 CONSTANT Ctrl-C ( User interrupt )
28 CONSTANT Ctrl-Break ( Not defined by standard )
-10 CONSTANT 0Divide
HEX
23 CONSTANT cc-int ( Control-C software interrupt number from DOS)
1B CONSTANT cb-int ( Control-Break software interrupt from BIOS)
0 CONSTANT /0-int ( Zero Divide interrupt )
0 0 IN/OUT NEED m1
0 0 IN/OUT NEED rst
NEED MAIN
ASM FWD, ( skip the variables )
VARIABLE DP ( start free ram = HERE, set by END command )
VARIABLE S0 ( top of stack )
VARIABLE R0 ( top of return stack )
VARIABLE BASE ( radix ) 0A BASE ! ( decimal )
2VARIABLE /0-save ( we will want to save the vectors )
2VARIABLE cb-save
THEN,
SEPSSEG? [IF] AX CS <SEG pssize # AX ADD AX SS >SEG [THEN]
FIND PSIZE [IF] DROP ( PSIZE is constant size of program seg)
PSIZE 0 10. D+ 10 SM/REM NIP
DUP 10 * rssize - DUP # SP MOV ( set param stack )
CELL- # S0 [] MOV ( set S0 )
DUP 10 * # BP MOV BP R0 [] MOV ( set return stack, R0 )
4A # AH MOV SEPSSEG? [IF] pssize + [THEN] # BX MOV 21 INT [THEN]
FIND PSIZE [IF] DROP [ELSE]
rssize NEGATE DUP # SP MOV ( set param stack )
CELL- # S0 [] MOV ( set S0 )
0 # BP MOV BP R0 [] MOV ( set return stack, R0 ) [THEN]
CLD CALL' m1 ( call main program )
CODE bye
CALL' rst ( restore the interrupt handlers )
4C00 # AX MOV 21 INT END-CODE
INCLUDE INTS \ Interrupt handlers
\ We have included exceptio.4th here so we could modify the
\ definition of THROW
VARIABLE exfp \ Exception frame pointer
CODE CATCH
SI POP AX POP \ retAddr execAddr
BP DEC BP DEC SI [BP] MOV
BP DEC BP DEC SP [BP] MOV
BP DEC BP DEC exfp [] BX MOV BX [BP] MOV
BP exfp [] MOV
AX CALLI
[BP] AX MOV AX exfp [] MOV
AX AX XOR AX PUSH
4 +[BP] AX MOV 6 # BP ADD
AX JMPI
END-CODE
1 0 IN/OUT
CODE throw
exfp [] BP MOV [BP] BX MOV BX exfp [] MOV
2 +[BP] SP MOV AX PUSH
4 +[BP] AX MOV
6 # BP ADD AX JMPI
END-CODE
1 0 IN/OUT
: THROW ?DUP IF throw THEN ;
0 0 IN/OUT
: ABORT Abort THROW ;
\ CONTROL-C HANDLER
L: cc-entry ( actual interrupt handler )
DECIMAL Ctrl-C HEX # AX MOV AX PUSH
CALL' THROW \ Never returns
\ CONTROL-BREAK HANDLER (sets flag)
VARIABLE brk
L: cb-entry ( actual interrupt handler )
( save registers )
AX PUSH DS PUSHSEG AX CS <SEG AX DS >SEG \ save AX, DS, set DS
-1 # brk [] MOV \ set flag
DS POPSEG AX POP
IRET FORTH
L: /0-entry
0Divide # AX MOV AX PUSH
CALL' THROW
0 0 IN/OUT
: m1 \ hidden MAIN
/0-int get-handler /0-save 2! \ get and save old handlers
cb-int get-handler cb-save 2!
?CS: cc-entry cc-int set-handler \ set handlers to us
?CS: cb-entry cb-int set-handler
?CS: /0-entry /0-int set-handler
['] MAIN CATCH CASE
0 OF EXIT ENDOF \ Normal finish
Abort OF S" Abort" ENDOF
Ctrl-C OF S" Control-C" ENDOF
Ctrl-Break OF S" Control-Break" ENDOF
0Divide OF S" Divide by zero" ENDOF
DECIMAL . S" ? uncaught" 0 ENDCASE
TYPE ." exception--Quiting Program" CR
;
0 0 IN/OUT
: rst \ restore handlers
/0-save 2@ /0-int set-handler \ restore handlers
( We dont need to restore the control-C handler )
cb-save 2@ cb-int set-handler
;
\ We will handle control-break by intercepting BDOS and EMIT
\
VARIABLE of 1 of !
CODE BDOS
0 # brk [] CMP =0 ~ IF, 0 # brk [] MOV
Ctrl-Break # AX MOV AX PUSH CALL' THROW THEN,
AL AH MOV BX DX MOV 21 INT AH AH XOR RET END-CODE
HERE 1 ALLOT
CODE EMIT
0 # brk [] CMP =0 ~ IF, 0 # brk [] MOV
Ctrl-Break # AX MOV AX PUSH CALL' THROW THEN,
AL OVER [] MOV 40 # AH MOV 1 # CX MOV DUP # DX MOV
of [] BX MOV 21 INT RET END-CODE DROP
FORTH 0A = [IF] DECIMAL [THEN]